home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / emacs / bookmode.el next >
Encoding:
Text File  |  2003-02-09  |  54.5 KB  |  1,687 lines
  1. ;;;;;;;;;;;;;;;;;; bookmode.el ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; bookmode for emacs for interacting with various programs such as
  3. ;;; maxima, dfplot, xplot, shells, octave, maple Regions of text can be
  4. ;;; made sensitive, and clicking on these regions can run commands which
  5. ;;; will then possibly modify the buffer or bring up a display or bring
  6. ;;; in other files.  The input for the commands is edited, killed yanked
  7. ;;; etc, as if this were a normal buffer.  It also allows hypertext
  8. ;;; links, using the push-file ;;; Copyright William F. Schelter
  9. ;;;
  10. ;; This file is part of GNU Emacs and is covered by the Gnu GPL:
  11. ;;
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 1, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26. ;;
  27. ;; The following is a "simple shell" much like the one in version 18
  28. ;; of emacs.   Unfortunately cmint breaks most code which tries to use
  29. ;; the shell mode, and is rather complex.  
  30. ;;
  31. (require 'sshell)
  32. ;;
  33. ;; Bugfix, default.el also contains this line. 
  34. (setq auto-mode-alist (cons '( "\\.bk$" . book-mode) auto-mode-alist))
  35. ;;
  36.  
  37. (defvar book-faces nil)
  38. (defvar book-face-default-background "pink")
  39. (defvar book-face-default-foreground "white")
  40. (defvar under-x-windows (eq (framep (selected-frame)) 'x))
  41.  
  42. (defun def-book-face (name eval-fun &optional copy-face bg fg)
  43.   (make-face name)
  44.   (put name 'book-eval-fun eval-fun)
  45.   (or (member name book-faces)
  46.       (setq book-faces (cons name book-faces)))
  47.   (if copy-face (copy-face copy-face name))
  48.   (cond ((and 
  49.       (eq (framep (selected-frame)) 'x)
  50.       (x-display-color-p))
  51.      (set-face-background name (or bg book-face-default-background))
  52.      (set-face-foreground name (or fg book-face-default-foreground)))
  53.     ((or bg fg) (invert-face name))))
  54.  
  55.  
  56. (def-book-face 'book-result nil 'bold "blue" "white")
  57. (def-book-face 'book-modified-result nil 'default "pink" "white")
  58. (def-book-face 'book-mouse-face nil 'underline "black" "white")
  59. (def-book-face 'book-mouse-face nil 'underline "white" "blue")
  60. (def-book-face 'book-mouse-face nil 'underline "white" "blue")
  61.  
  62. (defun show-saved-properties (&optional pos)
  63.   "Show properties at point which will be saved"
  64.   (interactive "d")
  65.   (let ((lis saved-properties) tem (ans "Props: "))
  66.     (while lis
  67.       (cond ((setq tem (get-text-property pos (car (car lis))))
  68.          (setq ans (format "%s (%s %s)" ans (car (car lis)) tem))))
  69.       (setq lis (cdr lis)))
  70.   (message "%s" ans)
  71.   ans
  72.   ))
  73.  
  74. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75. ;;;; set up menu bar on top, to allow popping file.
  76.  
  77. (defvar bookmode-menu-bar-book-menu (make-sparse-keymap "Book"))
  78.  
  79. (define-key bookmode-menu-bar-book-menu [kill-emacs] '("Exit No Saving!" . kill-emacs))
  80. (define-key bookmode-menu-bar-book-menu [exit-emacs] '("Exit Emacs" . book-save-buffers-kill-emacs))
  81.  
  82.  
  83.  
  84. (define-key bookmode-menu-bar-book-menu [separator-xx]  '("--"))
  85. (define-key bookmode-menu-bar-book-menu [bk-hardcopy] '("Print" . bk-hardcopy))
  86. (define-key bookmode-menu-bar-book-menu [save-in-home] '("Save to Home" . save-in-home))
  87. (define-key bookmode-menu-bar-book-menu [pop-find-file] '("Back" . pop-find-file))
  88.  
  89. (put 'pop-find-file 'menu-enable 'find-file-pushed)
  90.  
  91.  
  92.  
  93.  
  94.  
  95. (define-key menu-bar-file-menu [pop-find-file] '("Back to previous file" . pop-find-file))
  96.  
  97. (defun book-save-buffers-kill-emacs ()
  98.   (interactive)
  99.   (offer-to-save-books)
  100.   (kill-emacs))
  101.  
  102. ;;;
  103.  
  104.  
  105. (defvar book-mode-map nil "Keymap for book mode" )
  106. (defvar properties-to-save '(face book-command-arg read-only))
  107. (defun book-mode ()
  108.  "
  109. Book mode provides commands for making certain regions sensitive
  110. and putting commands on these regions.
  111.  
  112. The special keys or clicks in this mode are
  113. \\<book-mode-map>
  114. \\{book-mode-map}
  115.  
  116. Use \\[book-eval] or equivalently \\[book-mouse-eval] to run a command
  117. associated to a region.  Such regions are distinguished by a different
  118. face:  underlining, inverse video or a different font depending on
  119. the screen capabilities.   Some such commands modify a result field
  120. which is further in the buffer.   You may modify the command field
  121. to try different parameters etc, and then reexecute.
  122.  
  123. \\[show-saved-properties] shows what commands are associated to
  124. the current point.
  125.  
  126. Creating book files:
  127. ===================
  128. After bringing in a new file in book mode (possibly by using
  129. find file for a file with the .bk suffix, after making sure
  130. bookmode.el has been loaded),
  131.  use \\[book-mark-for-shell-eval] to make a region sensitive 
  132.  for \\[book-mouse-eval].  This would also prompt for the shell 
  133.  command you wish to run when that region is clicked on,
  134.  use \\[book-mark-for-maxima-eval] to mark a region for evaluation 
  135.  by maxima  or
  136.  use \\[book-mark-for-maple-eval] to mark a region for evaluation 
  137.  by maple.
  138.  
  139. To mark a region with other faces such as dfplot-eval use
  140. \\[set-face-region].
  141.  
  142. If you edit a book-mode file without bringing it in bookmode, or
  143. in another editor, you may edit the fields up to the end of the initial
  144. s expression (i.e. up to the \page character), in order to change the filenames
  145. or other material.   You may not edit the material after that \page, however
  146. since the numbering scheme for tracking regions starts at that point, and
  147. so editing after it would mean all offsets would likely be incorrect.
  148.  
  149. "  
  150.   (interactive)
  151.   (cond (buffer-read-only
  152.      (toggle-read-only 0)
  153.      (auto-save-mode 0)))
  154.   (make-local-variable 'write-region-annotate-functions)
  155.   (or (member 'book-write-region-annotate write-region-annotate-functions)
  156.       (setq write-region-annotate-functions
  157.         (cons 'book-write-region-annotate
  158.           write-region-annotate-functions)))
  159.   (setq under-x-windows (eq (framep (selected-frame)) 'x))
  160.   (setq major-mode 'book-mode)
  161.   (setq mode-name "Book")
  162.   (or (boundp 'saved-properties)
  163.       (setq saved-properties 
  164.         '((face) (book-command-arg) (read-only) )))
  165.   (let ((lis book-faces) f)
  166.     (while lis
  167.       (setq f (car lis))(setq lis (cdr lis))
  168.       (cond ((eq (framep (selected-frame)) 'x)
  169.          (cond ((get f 'book-eval-fun)
  170.             (or (face-differs-from-default-p f)
  171.                 (copy-face 'bold-italic f))
  172.             (or (face-differs-from-default-p f)
  173.                 (set-face-underline-p f t)))
  174.                (t
  175.             (or (face-differs-from-default-p f)
  176.                 (copy-face 'bold f))))))
  177.       (or (face-differs-from-default-p f)
  178.           (invert-face f))))
  179.   (if book-mode-map
  180.     nil
  181.   (setq book-mode-map (make-keymap))
  182.   (let ((i ?\ ))
  183.     (while (<= i ?~)
  184.       (define-key book-mode-map (make-string 1 i) 'book-self-insert)
  185.       (setq i (+ i 1))))
  186.   (define-key book-mode-map "\C-d" 'book-delete-char)
  187.  
  188.   (define-key book-mode-map [mouse-3] 'book-mouse-eval)
  189.   (define-key book-mode-map [double-down-mouse-1] 'book-mouse-eval)
  190.   (define-key book-mode-map [double-mouse-1] 'book-mouse-eval)
  191.   
  192.   
  193.   (define-key book-mode-map "\C-cm" 'book-mark-for-maxima-eval)
  194.   (define-key book-mode-map "\C-cu" 'book-unmark-all)
  195.   (define-key book-mode-map "\C-cr" 'book-insert-sample-result)
  196.   (define-key book-mode-map "\C-cs" 'book-mark-for-shell-eval)
  197.   (define-key book-mode-map "\C-cl" 'book-mark-for-elisp-eval)
  198.  
  199.   (define-key book-mode-map "\C-cf" 'set-face-region)
  200.  
  201.   ;; hack
  202.   (define-key book-mode-map "\C-cp" 'book-mark-for-maple-eval)
  203.   (define-key book-mode-map "\C-cg" 'book-mark-for-gp-eval)
  204.   (define-key book-mode-map "\C-c\C-cs" 'book-mark-for-Splus-eval)
  205.   (define-key book-mode-map "\C-c\C-cr" 'book-mark-read-only)
  206.   (define-key book-mode-map "\C-ca" 'book-mark-for-mma-eval)
  207.   ;;
  208.  
  209.   (define-key book-mode-map "\C-ce" 'book-eval)
  210.   (define-key book-mode-map "\C-c?" 'show-saved-properties)
  211.   (define-key book-mode-map [menu-bar book] (cons "Book" bookmode-menu-bar-book-menu))
  212.    )
  213.   (use-local-map book-mode-map)
  214.   ;; 30 xterminals beep randomly can really be anoying!
  215.  ;  (setq visible-bell t)
  216.   (setq trim-versions-without-asking t)
  217.   )
  218.  
  219. ;;;
  220. ;;; hack. It is extremly easy to get clicked twice on
  221. ;;; an expression. This little hack record down the time
  222. ;;; of the last mouse-eval and ignore the current click if
  223. ;;; it is less than  time-between-mouse-evals  apart, the 
  224. ;;;; default is 3 seconds.
  225. ;;;;        
  226.  
  227. ;; I have removed this!   For 2 days i thought the mode was broken,
  228. ;; because it was doing nothing when I clicked... I guess I click too fast!
  229. ;; I have added a message to reinforce the idea that something is happening
  230. ;; when you click, to prevent double clicking..
  231. ;(defvar last-mouse-eval-time 0 "time of the last mouse-eval")
  232. ;(defvar time-between-mouse-evals 3)
  233.  
  234. ;(defun book-mouse-eval (click)
  235. ;  "\\<book-mode-map>Follow a node reference near point.
  236. ;At end of the node's text, moves to the next node, or up if none."
  237. ;  (interactive "e")
  238. ;  (message "%s:%d" (car click)
  239. ;     (- (nth 1 (current-time)) last-mouse-eval-time))
  240. ;  (cond ((member (car click) '(double-mouse-1 mouse-3))
  241. ;     (let* ((start (event-start click))
  242. ;        (window (car start))
  243. ;        (pos (car (cdr start))))
  244. ;       (select-window window)
  245. ;       (goto-char pos)) 
  246. ;     (let (time)
  247. ;       (setq time (nth 1 (current-time)))
  248. ;       (cond ((> (abs (- time last-mouse-eval-time))
  249. ;             time-between-mouse-evals)
  250. ;          (setq last-mouse-eval-time time)
  251. ;          (book-eval))
  252. ;         (t (message "you click too fast for mzou")))))))
  253.  
  254. (defun book-mouse-eval (click)
  255.   "\\<book-mode-map>Follow a node reference near point.
  256. At end of the node's text, moves to the next node, or up if none."
  257.   (interactive "e")
  258. ;  (message "%s" click)
  259.   (cond ((member (car click) '(double-mouse-1 mouse-3))
  260.      (let* ((start (event-start click))
  261.         (window (car start))
  262.         (pos (car (cdr start))))
  263.        (select-window window)
  264.        (goto-char pos))
  265.      (book-eval))))
  266.  
  267.  
  268. (defun count-expr (ch string)
  269.   (let ((n 0) (beg -1))
  270.     (while (setq beg (string-match ch string (+ beg 1)))
  271.       (setq n (+ n 1)))
  272.     n))
  273.  
  274. (defun book-result-next (pos)
  275.   "If next face change after pos is to book-result, return point"
  276.   (let ((p (next-single-property-change pos 'face)))
  277.     (and p (member (get-text-property p 'face) '(book-result
  278.                          book-modified-result
  279.                          ))
  280.      p)))
  281.  
  282. (defun book-eval ()
  283.   "Try to eval the current expression as delimited by the special
  284. characters"
  285.   (interactive)
  286.   (let* ((type (get-text-property (point) 'face))
  287.      (eval-fun (get type 'book-eval-fun))
  288.      )
  289.     (or eval-fun (error "No book-eval-fun for type %s" type))
  290.     (message "Using %s" eval-fun)
  291.     (save-excursion
  292.       (let* ((beg (or (previous-single-property-change (point) 'face) 1))
  293.          (end (or (next-single-property-change (point) 'face)
  294.               (point-max)))
  295.          (result (funcall eval-fun beg end type )))
  296.     (cond (result
  297.            (save-excursion
  298.          (goto-char end)
  299.            (let ((p (book-result-next end)))
  300.              (or p
  301.              (error "No place to put result: %s" result))
  302.            (setq result (maxima-trim-result result))
  303.            (goto-char p)
  304.            (delete-region p (next-single-property-change p 'face))
  305.            (cond ((and (string-match "\n" result)
  306.                    (not  (equal (current-column) 0)))
  307.               (insert "\n")))
  308.            (insert result)
  309.            (put-text-property p (point)  'face 'book-result)))))))) )
  310.  
  311. (defun book-insert-sample-result()
  312.   "Insert a place holder for a result from previous expression"
  313.   (interactive)
  314.   (let ((beg (point)) ans)
  315.     (insert   "RESULT ")
  316.     (put-text-property beg (- (point) 1) 'face 'book-modified-result)
  317.     (show-saved-properties beg)
  318.     ))
  319.  
  320. ;;;
  321. ;;;  hack.
  322. ;;;
  323. (defun book-unmark-all (&optional remove-all pos)
  324.   (interactive "P\nd")
  325.   " Remove marks on regions that contains the current point. If a numeric 
  326.     argument is given, it removes the read-only property also"
  327.   (let ((inhibit-read-only remove-all))
  328.     (book-unmark-expr pos)))
  329.  
  330. ;;;
  331. ;;;
  332. (defun book-unmark-expr (&optional pos)
  333.   (interactive "d")
  334.   "Remove special marks on regions that contain the current point.
  335.    cannot remove the read-only property though. Use book-unmark-all
  336.    to remove the read-only property"
  337.   (let ((lis saved-properties) prop
  338.     (inhibit-read-only t))
  339.     (while lis 
  340.       (setq prop (car (car lis))) (setq lis (cdr lis))
  341.       (if (get-text-property pos prop )
  342.       (remove-text-properties
  343.        (or (previous-single-property-change pos prop)
  344.            (point-min))
  345.        (or (next-single-property-change pos prop)
  346.            (point-max))
  347.        (list prop) ) ))))
  348.  
  349. (defun add-to-buffer (buf str)
  350.   (save-excursion
  351.     (set-buffer buf)
  352.     (goto-char (point-max))
  353.     (insert str)))
  354.  
  355. (defun alter-face-at (p value)
  356.   (let ((beg (previous-single-property-change (+ p 1) 'face))
  357.     (end (next-single-property-change p 'face)))
  358.     ;(message "%s" (list p beg end))
  359.     (put-text-property beg (or end (point-max)) 'face value)
  360.     ))
  361.     
  362. (defun book-self-insert (&optional arg)
  363.   "Change a result font to indicate the corresponding command was altered."
  364.   (interactive "p")
  365.   (maybe-change-result-field)
  366.    (self-insert-command arg))
  367.  
  368. (defun maybe-change-result-field ()
  369.   (let* ((p (point)) 
  370.      (prop (and (> p 1) (get-text-property (- p 1) 'face))))
  371.     (cond ((get prop 'insert)
  372.        (setq p (book-result-next (next-single-property-change
  373.                       (- p 1) 'face)))
  374.        (and p
  375.         (alter-face-at p 'book-modified-result))))))
  376.  
  377. (defun book-delete-char (n &optional killflag)
  378.   (interactive "p\nP")
  379.   (maybe-change-result-field)
  380.   (delete-char n killflag))
  381.  
  382.  
  383.  
  384. ;;;;;;;;; buffer property saving for a file.
  385.   
  386. (defun buffer-properties-prop (min max prop)
  387.   "Go thru buffer finding changes in value of PROP text property, and
  388. return a list of beg1 end1 value1 beg2 end2 value2 ...  for text
  389. values of PROP"
  390.   
  391.   ;;
  392.   ;; Bug fix, the original version does work when the the char
  393.   ;; at MIN or MAX have some special marks.   7-24-95, mzou
  394.   ;;                                      
  395.   ;; should write a better version!
  396.   ;; 
  397.   (let ((p min) beg end beginning ans alist val tem)
  398.     ;; check to see if MIN has non-nil mark
  399.     (and p (setq beginning (get-text-property p prop))) 
  400.     (while (and p (or (setq beg (next-single-property-change  p prop))
  401.               beginning))   ; the whole buffer may be marked
  402.                     ; read-only. 
  403.                     ;
  404.       (cond (beginning              ; if there are marks at MIN
  405.          (setq beg min)         ; save it first.
  406.          (setq beginning nil))) ; 
  407.       (or (number-or-marker-p beg)  ; there are cases when beg is nil,
  408.       (setq beg max))           ; and it broke there. ???
  409.       (cond ((>= beg max)           ; 
  410.          (setq beg max)))       ; if called on a region ...
  411.  
  412.       (setq end (next-single-property-change beg prop))
  413.       (or (number-or-marker-p end)  ;
  414.       (setq end max))           ; bug fix
  415.  
  416.       (cond ((>= end max)
  417.          (setq end max)
  418.          (setq p nil)) 
  419.             ((get-text-property end prop)
  420.          (setq p (- end 1)))
  421.         (t (setq p end)))
  422.       (cond ( (setq val (get-text-property beg prop)) ; save non-nil only 
  423.           (or (setq tem (assoc val ans))
  424.           (setq ans (cons (setq tem (list val)) ans)))
  425.           (setq tem (nconc tem (list beg end)))))
  426.       )
  427.     ans))
  428.  
  429.  
  430. (or (member 'install-props-after-insert-file after-insert-file-functions)
  431.        (setq after-insert-file-functions
  432.         (cons 'install-props-after-insert-file
  433.           after-insert-file-functions)))
  434.  
  435. (defvar install-props-magic "\n"
  436.   "A regexp such that (looking-at install-props-magic) is t
  437. and  going (match-end 0) will move us to the beginning of the
  438. saved-properties list to install.  The saved-properties list is
  439. followed by a new page character, and then the regular text of the
  440. file")
  441.  
  442. (defun install-props-after-insert-file (n)
  443.     (cond
  444.      ((looking-at install-props-magic)
  445.       (install-props-after-insert-file1 n))
  446.      (t n)))
  447.  
  448. ;;;
  449. ;;; hack, insert mouse-face property on theose regions
  450. ;;; which are suppose to be executed when a click event
  451. ;;; happens on them.  These regions are marked with one 
  452. ;;; of the following faces.
  453. ;;;
  454. (setq put-mouse-face-on-them nil)
  455. (defvar put-mouse-face-on-them
  456.   (list 'book-shell-eval 'book-elisp-eval 'dfplot-eval 
  457.     'maxima-eval-insert 'maxima-eval 'octave-eval
  458.     'xplot-eval 'shell-eval-region 'maple-eval
  459.     'gp-eval 'Splus-eval 'book-shell-eval-insert 
  460.     'maple-eval-insert 'gp-eval-insert 'mma-eval 
  461.     'mma-eval-insert 'Splus-eval-insert))
  462. ;;;
  463. ;;;
  464. (defun install-props-after-insert-file1 (n)
  465.   (let* (val (pt (point)) (mod (buffer-modified-p)))
  466.     (goto-char (match-end 0))
  467.     (let ((saved-properties (read (current-buffer)))
  468.       (end (point)))
  469.       (or (looking-at " ") (error "bad props"))
  470.       (forward-char 1)            ;past new page mark.
  471.       (delete-region pt (point))
  472.       (let ((lis saved-properties)
  473.         prop x values)
  474.     (while lis
  475.       (setq x (car lis))
  476.       (setq lis (cdr lis))
  477.       (setq prop (car x))
  478.       (setq values (cdr x))
  479.       (while values
  480.         (setq x (car values))
  481.         (setq values (cdr values))
  482.         (setq val (car x))
  483.         (setq x (cdr x))
  484.         (while x
  485.           (put-text-property (car x) (nth 1 x)  prop val)
  486.           ;;
  487.           ;; hack 
  488.           (cond ( (member val put-mouse-face-on-them )
  489.               (put-text-property (car x) (nth 1 x)
  490.                      'mouse-face 'book-mouse-face)))
  491.           ;; 
  492.           (setq x (nthcdr 2 x))))
  493.       ))
  494.       (or mod (set-buffer-modified-p nil))
  495.       (- n (- end pt))
  496.       )))
  497.  
  498.  
  499.  
  500.  
  501. ;; unfortunately format truncates at newlines...
  502. ;; format "%s%S " install-props-magic ans
  503. (defun book-write-region-annotate (beg end)
  504.   (save-excursion
  505.     (let (ans prop (lis properties-to-save) vals string)
  506.       (while lis
  507.     (setq prop (car lis)) (setq lis (cdr lis))
  508.     (setq vals  (buffer-properties-prop beg end prop))
  509.     (cond (vals
  510.            (setq ans (cons (cons prop vals)
  511.                    
  512.                    ans))))
  513.     )
  514.       (cond (ans
  515.          (setq ans (nreverse ans))
  516.          (let ((buf (generate-new-buffer " saving")))
  517.            (set-buffer buf)
  518.            (insert install-props-magic)
  519.            (prin1 ans buf)
  520.            (insert " ")
  521.            (setq string (buffer-substring (point-min) (point-max)))
  522.            (kill-buffer buf)))
  523.         (t  (setq string (format "%s%S " install-props-magic ans ))))
  524.       (list (cons 1 string)))))
  525.  
  526.  
  527. (defun set-face-region (&optional face)
  528.   "Make the current region have FACE, eg dfplot-eval, octave-eval"
  529.   (interactive)
  530.   (or face (setq face (completing-read "Face: "
  531.                        (apply 'vector (face-list)))))
  532.   (cond ((stringp face) (setq face (intern face))))
  533.   (put-text-property (region-beginning) (region-end) 'face face)
  534.   (put-text-property (region-beginning) 
  535.              (region-end) 
  536.              'mouse-face 'book-mouse-face)
  537.   )
  538.  
  539. ;;;;;;;; code for evaluation of general form in shell ;;;
  540. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  541.  
  542. (def-book-face 'book-shell-eval 'book-shell-eval 'bold "YellowGreen" "black")
  543. (def-book-face 'book-elisp-eval 'book-elisp-eval 'bold  "YellowGreen" "red2")
  544. (def-book-face 'book-elisp-eval 'book-elisp-eval 'bold  "White" "red2")
  545.  
  546. (defvar book-command-arg-history nil)
  547.  
  548. (defun book-mark-for-shell-eval (&optional do-insert beg end com1)
  549.   "Mark the region for evaluation by shell.  You must quote spaces
  550.   with control-q, because of the completion mechanism.  If a numeric
  551.   argument is set then the next <Result> place will get the output
  552.   from running the shell command.  If 'insert' mode is specified then
  553.   the emacs will wait until the command completes, whereas otherwise
  554.   it will run in the background." 
  555.  
  556.   (interactive "P\nr")
  557.   (let ((com (or
  558.           com1 (get-text-property beg 'book-command-arg))) 
  559.     (table
  560.      (buffer-properties-prop (point-min) (point-max) 'book-command-arg)))
  561.     (book-unmark-expr beg) 
  562.     (put-text-property beg end 'face 
  563.                (if do-insert 'book-shell-eval-insert 'book-shell-eval
  564.                ))
  565.     (put-text-property beg
  566.                end
  567.                'book-command-arg
  568.                (or com1 
  569.                (completing-read "Shell Command: " table nil nil
  570.                         com  'book-command-arg-history
  571.                         )))
  572.     (or (not do-insert) (maybe-add-result-field end))
  573.     ))
  574.  
  575. (defun maybe-add-result-field (end)
  576.   (or
  577.    (not book-maxima-auto-result-insert)
  578.       (book-result-next end)
  579.       (save-excursion (goto-char end)
  580.               (insert
  581.                (nth (random (length book-maxima-auto-result-insert))
  582.                 book-maxima-auto-result-insert))
  583.               (book-insert-sample-result))))
  584.  
  585.  
  586. (defun book-mark-for-elisp-eval (&optional beg end com1)
  587.   "Mark for elisp eval.   You must quote spaces with control-q, because
  588.    of the completion mechanism."
  589.   (interactive "r")
  590.   (let ((com (or com1 (get-text-property beg
  591.                      'book-command-arg)))
  592.     (table (buffer-properties-prop (point-min) (point-max)
  593.                        'book-command-arg))
  594.     )
  595.     (book-unmark-expr beg)
  596.     (put-text-property beg
  597.                end
  598.                'face 'book-elisp-eval)
  599.     (put-text-property beg
  600.                end
  601.                'mouse-face 'book-mouse-face)
  602.     (put-text-property beg
  603.                end
  604.                'book-command-arg
  605.                (or com1 
  606.                (completing-read "Elisp Command: " table nil nil
  607.                         com  'book-command-arg-history
  608.                         )))))
  609. (defun book-elisp-eval (beg end type &optional command)
  610.   (let ((com (or command (get-text-property beg 'book-command-arg))))
  611.     (eval (read com)))
  612.   nil)
  613.  
  614. ;;;
  615. ;;; mark a region to be read-only. This is primarily for
  616. ;;; buttons in the buffer. (don't want students  midify them)
  617. ;;;  7-24-95, mzou
  618. ;;;
  619. (defun book-mark-read-only (&optional beg end)
  620.   "Mark the current region read-only. To remove read-only property,
  621.     use the function book-unmark-expr"
  622.   (interactive "r")
  623.   (put-text-property beg end 'read-only t)
  624.   (message "region [%d %d] marked read-only" beg end))
  625. ;;;
  626. ;;;
  627.  
  628. (defvar find-file-pushed nil "List of file positions from find-file-pushed")
  629. (defun push-find-file (name &optional string)
  630.   "Follow a link to FILENAME optionally searching for STRING in the file"
  631.   (interactive)
  632.   (setq  find-file-pushed
  633.      (cons (make-marker )  find-file-pushed))
  634.   (set-marker (car find-file-pushed) (point) (current-buffer))
  635.   (find-file name)
  636.   (cond (string
  637.      (let ((at (point)))
  638.        (goto-char (point-min))
  639.        (or (search-forward string nil t)
  640.            (goto-char at)))))
  641.   )
  642. (defun pop-find-file ()
  643.   "If you have followed a link, return back to where you were"
  644.   (interactive)
  645.   (cond (find-file-pushed
  646.      (let ((at (car find-file-pushed)))
  647.        (switch-to-buffer (marker-buffer at))
  648.        (goto-char at)
  649.        (setq find-file-pushed (cdr find-file-pushed))
  650.        (set-marker at nil))))
  651.   nil)
  652.  
  653. ;;;;;;;;;;;Postscript insertion stuff;;;;;;;;;;;;;;
  654. (def-book-face 'book-postscript-insert 'book-postscript-insert-eval nil
  655.   "beige" "black")
  656. (defvar book-faces-that-make-postscript '((dfplot-eval "~/dfplot.ps")
  657.                       (xplot-eval "~/zplot.ps")
  658.                       (maxima-eval "~/maxout.ps")
  659.                       (octave-eval "~/gnuplot.ps")
  660.                       (maxima-eval-insert "~/maxout.ps")
  661.                       ))
  662.  
  663.  
  664. (defun book-postscript-insert-eval (beg end type)
  665.   (let* ((com (get-text-property beg 'book-command-arg))
  666.      (p (previous-single-property-change beg 'face))
  667.      (tem (and p (assoc (get-text-property (- p 1) 'face)
  668.                 book-faces-that-make-postscript)))
  669.      (menu 
  670.         (list
  671.            "Do What1?"
  672.          (list "Insert Named Postscript File" 'book-set-postscript-value
  673.                beg end)
  674.          (and (car com)
  675.               (list
  676.                "View Current Postscript" 'book-view-postscript   (car com)))
  677.          (and tem
  678.               (list (concat "Set Postscript to "(nth 1 tem))
  679.                 'book-set-postscript-value beg end (nth 1 tem)))
  680.         
  681.           (and tem
  682.                (list (concat "View "(nth 1 tem))
  683.                  'call-process  "ghostview" nil nil nil
  684.                  (expand-file-name(nth 1 tem))
  685.                  ))
  686.           (list "Cancel")
  687.           )))
  688.      
  689.     (setq menu (delete nil menu))
  690.     (setq com (x-popup-menu t (list "Do whate? " menu)))
  691.     (message "%s" com)
  692.     (eval com)
  693.     nil
  694.     ))
  695.  
  696. (defun book-view-postscript (string)
  697.   (let ((buf (get-buffer-create "ps view")))
  698.     (set-buffer buf)
  699.     (erase-buffer)
  700.     (insert string)
  701.     (call-process-region (point-min) (point-max) "sh" t
  702.              0 ; means dont wait.
  703.              nil "-c"
  704.              ;; construct command to pass to the shell.
  705.              (concat
  706.               (cond ((looking-at "%PS") "")
  707.                 (t "gzip -dc | "))
  708.               "ghostview -")
  709.              
  710.     )))
  711.      
  712. (defun book-set-postscript-value ( beg end &optional file)
  713.   (interactive "r")
  714.   "Put the postscript FILE as a file to insert for current region"
  715.   (or file (setq file (read-file-name "Postscript file: " )))
  716.   (let* ((date          (nth 5 (file-attributes file)))
  717.          (buf (generate-new-buffer "pszip"))
  718.      string)
  719.     (save-excursion
  720.       (set-buffer buf)
  721.       (insert-file-contents file nil)
  722.       (call-process-region  (point-min)(point-max) "gzip" t buf nil "-c")
  723.       (setq string (buffer-substring (point-min) (point-max)))
  724.       (kill-buffer buf))
  725.     (put-text-property beg end 'book-command-arg
  726.                (list string date))))
  727.  
  728. ;;;;;;;;;;end postscript insert stuff;;;;;;;;;;
  729.  
  730. (defvar book-shell-program nil
  731.  "Program to use for shell for executing commands given to book-shell-eval
  732. `sh' will be used if none is supplied")
  733.  
  734. (defun book-start-process (name buffer program &rest prog-args)
  735.   "Start a program in a subprocess.  Return the process object for it.
  736. Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
  737. NAME is name for process.  It is modified if necessary to make it unique.
  738. BUFFER is the buffer or (buffer-name) to associate with the process.
  739. "
  740.   (let ((proc (apply 'start-process name buffer program prog-args))
  741.     (i 0)
  742.     result
  743.     tem
  744.     buf)
  745.     (put-process-prop proc 'last-output "")
  746.     (setq buf (get-buffer buffer))
  747.     (set-marker (process-mark proc)
  748.         (if buf (save-excursion (set-buffer buf) (point-max)) 1)
  749.         (set-process-buffer proc (or buf (get-buffer-create buffer))))
  750.     (put-process-prop proc 'started nil)
  751.     (set-process-filter proc 'book-process-filter)
  752.     (while (< i 10)
  753.       (cond ((get-process-prop proc 'started)
  754.          (setq i 11)
  755.          (setq result proc))
  756.         (t (setq i (+ i 1))
  757.            (sleep-for 1))))
  758.     (or result (error "could not start process %s" name))
  759.     result))
  760.  
  761.  
  762. (defun book-shell-eval (beg end type &optional command)
  763.   (let* (res
  764.      (com (or command (get-text-property beg 'book-command-arg)))
  765.      (sh (or book-shell-program
  766.                        "/bin/sh"))
  767.      (proc (start-process "*book-shell-output*" "*book-out*"
  768.                    sh
  769.                    "-s"
  770.                    ))
  771.      (buf (process-buffer proc))
  772.      (marker (process-mark proc))
  773.      (at-end "<AT fayve END>")
  774.      )
  775.     (let ((i 10))
  776.       (while (> i 0)
  777.     (cond ((setq beg (marker-position marker))
  778.            (setq i -1)))
  779.     (setq i (- i 1))
  780.     (sit-for 0 400)
  781.     ))
  782.     (or beg (error "problem starting process ?"))
  783.     (cond (com
  784.        (message "executing in %s: %s" sh com)
  785.        (process-send-string proc
  786.                 (concat com
  787.                     ";echo '" at-end
  788.                     "'\nexit\nexit\n\nn"))
  789.        ))
  790.     (cond ((eq type 'book-shell-eval-insert)
  791.        ;; must grab the result...
  792.        (while (equal (process-status proc) 'run)
  793.          (sleep-for  1))
  794.        (save-excursion
  795.          (set-buffer buf)
  796.          (goto-char beg)
  797.          (cond ((search-forward at-end nil t)
  798.             (message "..done")
  799.             (buffer-substring beg (- (point) (length at-end) 1)))
  800.            (t (error "did not terminate normally")))))
  801.       (t nil))))
  802.  
  803. (def-book-face 'book-shell-eval-insert 'book-shell-eval
  804.       'underline "YellowGreen" "black")
  805. (put 'book-shell-eval-insert 'insert t)
  806.  
  807. (defun dfplot-eval (beg end type)
  808.   "Call dfplot on a region and send output to ~/dfplot.ps"
  809.   
  810.   (let* ((default-directory "~/")
  811.      (proc (book-start-process "*book-dfplot-output*" "*book-out*"
  812.                  "dfplot")))
  813.     (let ((com     (concat (buffer-substring beg end)
  814.             " ;\n plot ; \n set output 'dfplot.ps' ;\n "
  815.             " replot \n\n quit \n"))
  816.       )
  817.       (message "executing %s" com)
  818.       (process-send-string proc com))))
  819.  
  820. (def-book-face  'dfplot-eval 'dfplot-eval 'underline "yellow2"  "black")
  821.  
  822. ;;;;;;;; code for maxima evaluation.;;;;;;;;;;;;;
  823. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  824.  
  825. ;; make maxima-eval-insert face do insertion of result
  826.  
  827. (def-book-face 'maxima-eval-insert 'maxima-eval 'underline "yellow" "black" )
  828.  
  829. (put 'maxima-eval-insert 'insert t)
  830.  
  831. (def-book-face 'maxima-eval 'maxima-eval 'underline "yellow" "black" )
  832.  
  833. (defvar maxima-eval nil)
  834.  
  835. (defun book-mark-for-maxima-eval (eval-only beg end)
  836.   "Mark the current region to be evaluated by maxima and
  837. substituted in the next book result region.   If a
  838. numeric arg is supplied, dont wait for the evaluation nor
  839. insert the result.  The variable book-maxima-auto-result-insert
  840. affects whether a sample result is inserted.
  841. "
  842.   (interactive "P\nr")
  843.   (put-text-property beg
  844.              end 
  845.              'face (if eval-only 'maxima-eval 'maxima-eval-insert))
  846.   (put-text-property beg
  847.              end
  848.              'mouse-face 'book-mouse-face)
  849.   (or eval-only
  850.       (not book-maxima-auto-result-insert)
  851.       (book-result-next end)
  852.       (save-excursion (goto-char end)
  853.               (insert
  854.                (nth (random (length book-maxima-auto-result-insert))
  855.                 book-maxima-auto-result-insert))
  856.               (book-insert-sample-result)))
  857.   (show-saved-properties beg)
  858.   )
  859.  
  860. (defun m1 (&optional eval-only )
  861.   (interactive "P")
  862.   (let (beg end)
  863.   (save-excursion
  864.     (progn (re-search-forward "[ \n\t]" nil t) (setq end (- (point) 1))))
  865.   (save-excursion
  866.     (progn (re-search-backward "[ \n\t]" nil t) (setq beg (+ 1 (point)))))
  867.   (book-mark-for-maxima-eval eval-only beg end)))
  868.   
  869. (defvar book-maxima-auto-result-insert '(" yields " " evaluates to "
  870.                      " returns " " produces " " gives " )
  871.   "If not nil a sample result field will be inserted after the
  872. maxima expression.   It should be a list of strings which will
  873. be used at random between the form to eval and the `result'")
  874.  
  875. (defvar book-maxima-ready-for-input nil)
  876.  
  877.  
  878. (defun add-to-process-buffer (proc str)
  879. ;  (setq me proc)
  880.   (let (moving (buf (current-buffer)))
  881.     (unwind-protect
  882.     (progn
  883.       (set-buffer (process-buffer proc))
  884.       (setq moving (= (point) (process-mark proc)))
  885.       (save-excursion
  886.         (goto-char (process-mark proc))
  887.         (insert str)
  888.         (set-marker (process-mark proc) (point)))
  889.       (if moving (goto-char (process-mark proc))))
  890.       (set-buffer buf))))
  891. (defun get-process-prop (proc prop)
  892.   (if (processp proc) (setq proc (intern (process-name proc))))
  893.   (get proc prop))
  894.  
  895. (defun put-process-prop (proc prop val)
  896.   (if (processp proc) (setq proc (intern (process-name proc))))
  897.   (put proc prop val))
  898.  
  899. (defvar last-maxima-result nil)
  900. (defvar book-result nil)
  901.  
  902. (defun book-maxima-process-filter ( proc str)
  903.   (let (tem )
  904.     (book-process-filter proc str)
  905.     (put-process-prop proc 'last-output
  906.               (concat (get-process-prop proc 'last-output)
  907.                   str))
  908.     (cond ((setq tem (string-match "(C[0-9]+)[ ]*$"
  909.                    (get-process-prop proc 'last-output)))
  910.        (setq book-maxima-ready-for-input t)
  911.        (setq last-maxima-result
  912.          (substring (get-process-prop proc 'last-output)  0 tem ))
  913.        (put-process-prop proc 'last-output "")
  914.        )
  915.       ((string-match ">>$" str)
  916.        (process-send-string proc ":t\n")
  917.        (message "had error")
  918.        (setq book-result "<had-error>"))
  919.       )))
  920.  
  921.  
  922. (defun book-process-filter ( proc str)
  923.   (add-to-process-buffer proc str)
  924.   (put-process-prop proc 'started t)
  925.   )
  926.     
  927. (defun maxima-restart ()
  928.   (setq maxima-eval nil)
  929.   (if (get-buffer "*maxima-eval*")
  930.       (kill-buffer (get-buffer "*maxima-eval*") )))
  931.  
  932. (defun book-maxima-interrupt ()
  933.   "Interrupt the *maxima-eval* process running for book mode"
  934.   (interactive)
  935.   (cond (maxima-eval
  936.      (interrupt-process maxima-eval))
  937.     (t (error "*maxima-eval* process not found"))))
  938.  
  939. (defun maxima-eval (beg end type)
  940.   "Evaluate the region returning a result"
  941.   (let (tem (process (get-process  "*maxima-eval*")))
  942.     (cond ((not  (and maxima-eval
  943.               (setq process (get-buffer-process maxima-eval))))
  944.        (cond ((and under-x-windows x-display-name
  945.                (not (getenv "DISPLAY")))
  946.           (setq process-environment
  947.             (cons (concat "DISPLAY=" x-display-name)
  948.                   process-environment))))
  949.        (let ((default-directory "~/"))
  950.          (setq maxima-eval (make-sshell "maxima-eval" "maxima" )))
  951.        (setq process (get-buffer-process  maxima-eval))
  952.        (set-process-filter process 'book-maxima-process-filter)
  953.        ))
  954.     (let ((com (buffer-substring beg end)))
  955.       (or (string-match  "[;$][ \t\n]*$" com)
  956.       (setq com (concat com ";" )))
  957.       (setq com (concat com "\n"))
  958.       (while (not book-maxima-ready-for-input)
  959.     (message "waiting till maxima ready for input..")
  960.     (process-send-string process "\n")
  961.     (sleep-for 1))
  962.       (message  "sending command :%s " com )
  963.       (setq last-maxima-result nil)
  964.       (process-send-string process com))
  965.     (cond ((equal type 'maxima-eval-insert)
  966.        (while (not last-maxima-result)
  967.          (message "waiting for result...")
  968.          (sleep-for 1))
  969.        (message "done")
  970.        (setq tem (maxima-trim-result last-maxima-result))
  971.        (setq last-maxima-result nil)
  972.        tem))))
  973.  
  974. (defun maxima-trim-result (x)
  975.   (let (tem)
  976.     (cond ((equal 1 (count-expr "\n" x))
  977.        (cond ((string-match "(D[0-9]+)" x)
  978.           (setq x (substring x (match-end 0)))))
  979.        (cond ((setq tem (string-match "\n$" x))
  980.           (setq x (substring x 0 tem))))
  981.        (cond ((not (string-match "\n" x))
  982.           (cond ((string-match "[ \t]+" x)
  983.              (setq x (substring x (match-end 0)))))))
  984.        x)
  985.       (t (cond ((setq tem (string-match "(D[0-9]+)" x))
  986.             (while (< tem (match-end 0))
  987.               (aset x tem ? )
  988.               (setq tem (+ tem 1)))))
  989.          x))))
  990. ;;;;;;;; end code for maxima evaluation.
  991.  
  992. ;; for octave eval
  993. (defun octave-eval (beg end type)
  994.   "Call octave on a region and send output to ~/octave.ps"
  995.   
  996.   (let* ((default-directory "~/")
  997.      (proc (book-start-process "*book-octave-output*" "*book-out*"
  998.                  "octave")))
  999.     (let ((com     (concat
  1000.         "gnuplot_binary='tk_gnuplot1';\n"
  1001.         "set title 'Plot for " (user-real-login-name)  " on "
  1002.                 (current-time-string) "';\n"
  1003.          (buffer-substring beg end)
  1004.             "\n quit;\n"
  1005.             ))) 
  1006.       (message "executing %s" com)
  1007.       (process-send-string proc com))))
  1008.  
  1009. (def-book-face 'octave-eval 'octave-eval 'underline "yellow3" "black")
  1010. ;; end octave
  1011.  
  1012.  
  1013. ;; xplot 
  1014. (defun xplot-eval (beg end type)
  1015.   "Call xplot on a region and send output to ~/xplot.ps"
  1016.   
  1017.   (let* ((default-directory "~/")
  1018.      (proc (book-start-process "*book-xplot-output*" "*book-out*"
  1019.                  "xplot")))
  1020.     (let ((com     (concat (buffer-substring beg end)
  1021.             "\n plot \n  quit ; \n quit;\n\n")))
  1022.       (message "executing %s"  com)
  1023.       (process-send-string proc com))))
  1024.  
  1025. (def-book-face 'xplot-eval 'xplot-eval 'underline "yellow3" "black")
  1026. ;; end xplot
  1027.  
  1028. (provide 'bookmode)
  1029.  
  1030. ;;;
  1031. ;;; additions from mzou adopting maxima to maple, and 
  1032. ;;; cours- name stuff.
  1033. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1034. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1035. ;;;
  1036. ;;  mkdir ~/course-name if not already there
  1037. ;;    copy the master file into it. These are
  1038. ;;    done by the shell script find_course,
  1039. ;;    push-find-file ~/course-name/master.bk
  1040. ;;    set the global variable course-name (???)
  1041. ;;
  1042. (defvar course-name nil)
  1043. (defvar project-name nil)
  1044. (defvar start-time nil)
  1045.  
  1046.  
  1047.  
  1048. (defun select-course (name)
  1049.    "Make a directory ~/name and copy the master file into it"
  1050.  (setq course-name  name)
  1051.  (push-find-file (concat name "/master.bk")))
  1052. ; (call-process "select_course" nil nil nil name)
  1053. ; (push-find-file (concat (getenv "HOME") "/" name "/master.bk"))
  1054. ; (setq start-time (current-time-string))
  1055. ; (message (concat (getenv "HOME") "/" name "/master.bk")))
  1056.  
  1057.  
  1058.  
  1059. ;;
  1060. ;;
  1061. ;;  copy the project file into ~/course-name/ and
  1062. ;;  push-find-file the-proj-file. 
  1063. ;;
  1064. (defun select-project (name)
  1065.    "Select a project. Copy the proj-file into the right place"
  1066.    (setq project-name name)    
  1067.    (push-find-file name))    
  1068.  
  1069. ;;;
  1070. ;;;  convert buffer to latex and print a hardcopy 
  1071. ;;;  if possible. have to write to a tmp-file in ~/
  1072. ;;;  because the usr may not have the permission to
  1073. ;;;  save the current buffer.
  1074. ;;;
  1075. (defun bk-hardcopy ( )
  1076.   "print out a nice hardcopy of the current buffer"
  1077.   (interactive)
  1078.   (let ((tmp-file) (old-back make-backup-files))
  1079.     (setq tmp-file (concat (getenv "HOME") "/pj_.bk"))
  1080.     (setq make-backup-files nil)
  1081.     (write-file tmp-file) 
  1082.     (setq make-backup-files old-back)
  1083.     (start-process "printbk" nil "printbk" tmp-file )
  1084.     ;(call-process "printbk"  nil nil tmp-file "&")
  1085.     )
  1086.   nil)    
  1087. ;;;
  1088. ;;; eval the shell command in region
  1089. ;;;
  1090. (def-book-face 'shell-eval-region 'shell-eval-region
  1091.   'bold "yellow2" "blue")
  1092. (defun shell-eval-region (beg end type)
  1093.   "Exec the shell command in region"
  1094.   (let* ((default-directory "~/")
  1095.      (proc (book-start-process "*book-shell-output*" "*book-out*"
  1096.                  "sh")))
  1097.     (let ((com     (concat (buffer-substring beg end)
  1098.             "\n exit \n")))
  1099.       (message "executing %s" com)
  1100.       (process-send-string proc com))))
  1101. ;;;
  1102. ;;;  A may be useful function. 
  1103. ;;;
  1104. (defun turnin-project ( )
  1105.   "Turn in the current project"
  1106.   (save-buffer)
  1107.   (let ( project-file )
  1108.     (setq project-file (concat (getenv "HOME") "/"
  1109.                 course-name "/"
  1110.                 project-name))
  1111.     (call-process "turnin_project" nil nil nil
  1112.           course-name project-file
  1113.           start-time (current-time-string) ) ))
  1114.  
  1115. (defun offer-to-save-books ()
  1116.   (let ((tem  (buffer-list))
  1117.     vars b)
  1118.     (while tem
  1119.       (setq b (car tem))
  1120.       (setq tem (cdr tem))
  1121.       (setq vars (buffer-local-variables b))
  1122.       (cond ((and
  1123.           (buffer-modified-p b)
  1124.           (eq (cdr (assoc 'major-mode vars)) 'book-mode)
  1125.           (y-or-n-p  (format "Save changes to %s as %s ?"
  1126.              (buffer-name b)
  1127.              (get-home-directory-name
  1128.               (buffer-file-name b)))
  1129.              ))
  1130.          (save-excursion (set-buffer b)
  1131.                  (save-in-home)))))))
  1132.  
  1133. (defun get-home-directory-name (name)
  1134.   (let ((p (file-name-nondirectory name))
  1135.     (dir "~/"))
  1136.     (cond ((string-match "/books/\\|/courses/" name)
  1137.        (setq f (substring name (match-beginning 0)))
  1138.        (setq dir (concat "~" (file-name-directory f)))
  1139.        (concat dir p))
  1140.       (t name))))
  1141.          
  1142. (defun save-in-home ()
  1143.   (interactive "")
  1144.   (let* ((name (buffer-file-name (current-buffer)))
  1145.      (new (get-home-directory-name name))
  1146.      (default-directory default-directory ))
  1147.     (make-directory (file-name-directory new) t)
  1148.     (write-file new)))
  1149.             
  1150.     
  1151. ;;;
  1152. ;;;
  1153. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1154. ;;;;;;;;;;; code for maple evaluation.;;;;;;;;;;;;;
  1155. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1156. ;;
  1157. ;; make maple-eval-insert face do insertion of result
  1158. ;;
  1159. (def-book-face 'maple-eval-insert 'maple-eval
  1160.   'underline "Greenyellow" "black" )
  1161.  
  1162. (put 'maple-eval-insert 'insert t)
  1163.  
  1164. (def-book-face 'maple-eval 'maple-eval 'underline "Greenyellow" "black" )
  1165.  
  1166. (defvar maple-eval nil)
  1167.  
  1168. (defun book-mark-for-maple-eval (eval-only beg end)
  1169.   "Mark the current region to be evaluated by maple and
  1170. substituted in the next book result region.   If a
  1171. numeric arg is supplied, dont wait for the evaluation nor
  1172. insert the result.  The variable book-maxima-auto-result-insert
  1173. affects whether a sample result is inserted.
  1174. "
  1175.   (interactive "P\nr")
  1176.   (put-text-property beg
  1177.              end 
  1178.              'face (if eval-only 'maple-eval 'maple-eval-insert))
  1179.   (put-text-property beg
  1180.              end
  1181.              'mouse-face 'book-mouse-face)
  1182.   (or eval-only
  1183.       (not book-maxima-auto-result-insert)
  1184.       (book-result-next end)
  1185.       (save-excursion (goto-char end)
  1186.               (insert
  1187.                (nth (random (length book-maxima-auto-result-insert))
  1188.                 book-maxima-auto-result-insert))
  1189.               (book-insert-sample-result)))
  1190.   (show-saved-properties beg)
  1191.   )
  1192. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1193. (defvar book-maple-ready-for-input nil)
  1194. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1195. (defvar last-maple-result nil)
  1196. (defun book-maple-process-filter ( proc str)
  1197.   (let (tem )
  1198.     (book-process-filter proc str)
  1199.     (put-process-prop proc 'last-output
  1200.               (concat (get-process-prop proc 'last-output)
  1201.                   str))
  1202.  
  1203.     (cond ((setq tem (string-match ";#z#"  ;;; terminating symbol  
  1204.                    (get-process-prop proc 'last-output)))
  1205.        (cond ((setq tem
  1206.             (string-match "^>>[ ]*$" ;;; the prompt
  1207.                       (get-process-prop proc 'last-output)))
  1208.           (setq book-maple-ready-for-input t)
  1209.           (setq last-maple-result (get-process-prop proc 'last-output))
  1210.           (put-process-prop proc 'last-output ">> "))
  1211.          )
  1212.       )
  1213.     )))
  1214. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1215. (defun maple-restart ()
  1216.   (setq maple-eval nil)
  1217.   (if (get-buffer "*maple-eval*")
  1218.       (kill-buffer (get-buffer "*maple-eval*") )))
  1219.  
  1220. (defun book-maple-interrupt ()
  1221.   "Interrupt the *maple-eval* process running for book mode"
  1222.   (interactive)
  1223.   (cond (maple-eval
  1224.        (interrupt-process maple-eval))
  1225.     (t (error "*maple-eval* process not found"))))
  1226.  
  1227. (defun maple-eval (beg end type)
  1228.   "Evaluate the region returning a result"
  1229.   (let (tem (process (get-process  "*maple-eval*")))
  1230.     (cond ((not  (and maple-eval
  1231.               (setq process (get-buffer-process maple-eval))))
  1232.        (cond ((and under-x-windows x-display-name
  1233.                (not (getenv "DISPLAY")))
  1234.           (setq process-environment
  1235.             (cons (concat "DISPLAY=" x-display-name)
  1236.                   process-environment))))
  1237.        (let ((default-directory "~/"))
  1238.          (setq maple-eval (make-sshell "maple-eval" "maple52" )))
  1239.        (setq process (get-buffer-process  maple-eval))
  1240.        (set-process-filter process 'book-maple-process-filter)
  1241.        (process-send-string process 
  1242.        "interface(echo=0,plotdevice=x11,prompt=`>> `,screenwidth=80);gc(0);")
  1243.        )
  1244.       )
  1245.     (let ((com (buffer-substring beg end)))
  1246.       (setq com (concat com ";#z#\n"))
  1247.       (while (not book-maple-ready-for-input)
  1248.     (message "waiting till maple ready for input..")
  1249.     (process-send-string process ";#z#\n")
  1250.     (sleep-for 1))
  1251.       (message  "sending command :%s " com )
  1252.       (setq last-maple-result nil)
  1253.       (process-send-string process com)
  1254.       )
  1255.     (cond ((equal type 'maple-eval-insert)
  1256.        (while (not last-maple-result)
  1257.          (message "waiting for result...")
  1258.          (sleep-for 1)
  1259.          )
  1260.        (message "done")
  1261.        (setq tem (maple-trim-result  last-maple-result))
  1262.        (setq last-maple-result nil)
  1263.        tem))))
  1264. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1265. (defun maple-trim-result (str)
  1266.   (let ( (tem) (x) (bgn 0) (end -1) (tstr) (ll) )
  1267.     (setq x "") (setq tstr "")
  1268.     (setq ll (length str))
  1269.     ;;
  1270.     ;; str contains mixed inputs and outputs, with inputs
  1271.     ;; matchs "^>>[^\n]*". Strip out all inpus. Also, maple
  1272.     ;; insert an extra "\n" at both the beginning and the end 
  1273.     ;; of its outputs (except for error mesg)
  1274.     ;;
  1275.     (while (setq end (string-match "^>>[^\n]*" str (+ end 1)))
  1276.       (or (< end bgn)
  1277.           (setq x (concat  x (substring str bgn end))))
  1278.       (setq tem (+ (match-end 0) 1))
  1279.       (if  (> ll tem)
  1280.       (setq tstr (substring str tem (+ tem 1))))
  1281.       ( cond  ( (string-equal tstr "\n") 
  1282.         (setq bgn  (+ tem 1)))
  1283.           (t (setq bgn tem)))
  1284.       )
  1285.     ;;
  1286.     ;; if there is output at all, x is at least of length 2
  1287.     ;; including a trailling \n\n (yes 2 of them).
  1288.     ;; Strip one \n out.
  1289.     ;;
  1290.     (if (< (length x) 2) 
  1291.     (setq x "OK")
  1292.       (setq x (substring x 0 (- (length x ) 1))))
  1293.     ;;
  1294.     ;; from maxima-trim-result. Strip out spaces if
  1295.     ;; output fits in one line.
  1296.     ;;
  1297.     (cond ((equal 1 (count-expr "\n" x))
  1298.        (cond ((setq tem (string-match "\n$" x))
  1299.           (setq x (substring x 0 tem))))
  1300.        (cond ((not (string-match "\n" x))
  1301.           (cond ((string-match "[ \t]+" x)
  1302.              (setq x (substring x (match-end 0)))))))
  1303.        x)
  1304.       (t x))))
  1305. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1306. ;;;;;;;;;;; code for gp evaluation.;;;;;;;;;;;;;
  1307. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1308. ;;
  1309. ;; make maple-eval-insert face do insertion of result
  1310. ;;
  1311. (def-book-face 'gp-eval-insert 'gp-eval 'underline "chartreuse" "black" )
  1312.  
  1313. (put 'gp-eval-insert 'insert t)
  1314.  
  1315. (def-book-face 'gp-eval 'gp-eval 'underline "chartreuse" "black" )
  1316.  
  1317. (defvar gp-eval nil)
  1318.  
  1319. (defun book-mark-for-gp-eval (eval-only beg end)
  1320.   "Mark the current region to be evaluated by gp and
  1321. substituted in the next book result region.   If a
  1322. numeric arg is supplied, dont wait for the evaluation nor
  1323. insert the result.  The variable book-maxima-auto-result-insert
  1324. affects whether a sample result is inserted.
  1325. "
  1326.   (interactive "P\nr")
  1327.   (put-text-property beg
  1328.              end 
  1329.              'face (if eval-only 'gp-eval 'gp-eval-insert))
  1330.   (put-text-property beg
  1331.              end
  1332.              'mouse-face 'book-mouse-face)
  1333.   (or eval-only
  1334.       (not book-maxima-auto-result-insert)
  1335.       (book-result-next end)
  1336.       (save-excursion (goto-char end)
  1337.               (insert
  1338.                (nth (random (length book-maxima-auto-result-insert))
  1339.                 book-maxima-auto-result-insert))
  1340.               (book-insert-sample-result)))
  1341.   (show-saved-properties beg)
  1342.   )
  1343. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1344.  
  1345. (defvar book-gp-ready-for-input nil)
  1346. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1347. (defvar last-gp-result nil)
  1348. (defun book-gp-process-filter ( proc str)
  1349.   (let (tem )
  1350.     (book-process-filter proc str)
  1351.     (put-process-prop proc 'last-output
  1352.               (concat (get-process-prop proc 'last-output)
  1353.                   str))
  1354.     (cond ((setq tem (string-match "\?[ ]*$"
  1355.                    (get-process-prop proc 'last-output)))
  1356.        (setq book-gp-ready-for-input t)
  1357.        (setq last-gp-result
  1358.          (substring (get-process-prop proc 'last-output)  0 tem ))
  1359.        (put-process-prop proc 'last-output "")
  1360.        )
  1361.       )))
  1362. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1363. (defun gp-restart ()
  1364.   (setq gp-eval nil)
  1365.   (if (get-buffer "*gp-eval*")
  1366.       (kill-buffer (get-buffer "*gp-eval*") )))
  1367.  
  1368. (defun book-gp-interrupt ()
  1369.   "Interrupt the *gp-eval* process running for book mode"
  1370.   (interactive)
  1371.   (cond (gp-eval
  1372.      (interrupt-process gp-eval))
  1373.     (t (error "*gp-eval* process not found"))))
  1374.  
  1375. (defun gp-eval (beg end type)
  1376.   "Evaluate the region returning a result"
  1377.   (let (tem (process (get-process  "*gp-eval*")))
  1378.     (cond ((not  (and gp-eval
  1379.               (setq process (get-buffer-process gp-eval))))
  1380.        (cond ((and under-x-windows x-display-name
  1381.                (not (getenv "DISPLAY")))
  1382.           (setq process-environment
  1383.             (cons (concat "DISPLAY=" x-display-name)
  1384.                   process-environment))))
  1385.        (let ((default-directory "~/"))
  1386.          (setq gp-eval (make-sshell "gp-eval" "gp" )))
  1387.        (setq process (get-buffer-process  gp-eval))
  1388.        (set-process-filter process 'book-gp-process-filter)
  1389.        (process-send-string process  "\n")
  1390.        )
  1391.       )
  1392.     (let ((com (buffer-substring beg end)))
  1393.       (setq com (concat com "\n"))
  1394.       (while (not book-gp-ready-for-input)
  1395.     (message "waiting till gp ready for input..")
  1396.     (process-send-string process "\n")
  1397.     (sleep-for 1))
  1398.       (message  "sending command :%s " com )
  1399.       
  1400.       (setq last-gp-result nil)
  1401.       (process-send-string process com)
  1402.       )
  1403.     (cond ((equal type 'gp-eval-insert)
  1404.        (while (not last-gp-result)
  1405.          (message "waiting for result...")
  1406.          (sleep-for 1)
  1407.          )
  1408.        (message "done")
  1409.        (setq tem (gp-trim-result  last-gp-result))
  1410.        (setq last-gp-result nil)
  1411.        tem))))
  1412.  
  1413. (defun gp-trim-result (x)
  1414.   (let (tem)
  1415.     (cond ((equal 0 (count-expr "\n" x))
  1416.        (setq x "OK")
  1417.        x)
  1418.       ((equal 1 (count-expr "\n" x))
  1419.        (cond ((string-match "%[0-9]+[ ]=" x)
  1420.           (setq x (substring x (match-end 0)))))
  1421.        (cond ((setq tem (string-match "\n$" x))
  1422.           (setq x (substring x 0 tem))))
  1423.        x)
  1424.       (t (cond ((setq tem (string-match "%[0-9]+[ ]=" x))
  1425.             (while (< tem (match-end 0))
  1426.               (aset x tem ? )
  1427.               (setq tem (+ tem 1)))))
  1428.              x)) ))
  1429. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1430. ;;;;;;;;;;; code for Splus evaluation.;;;;;;;;;;;
  1431. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1432. ;;
  1433. ;; make Splus-eval-insert face do insertion of result
  1434. ;;
  1435. (def-book-face  'Splus-eval-insert 'Splus-eval 'underline "LimeGreen" "black" )
  1436.  
  1437. (put 'Splus-eval-insert 'insert t)
  1438.  
  1439. (def-book-face 'Splus-eval 'Splus-eval 'underline "LimeGreen" "black" )
  1440.  
  1441. (defvar Splus-eval nil)
  1442.  
  1443. (defun book-mark-for-Splus-eval (eval-only beg end)
  1444.   "Mark the current region to be evaluated by Splus and
  1445. substituted in the next book result region.   If a
  1446. numeric arg is supplied, dont wait for the evaluation nor
  1447. insert the result.  The variable book-maxima-auto-result-insert
  1448. affects whether a sample result is inserted.
  1449. "
  1450.   (interactive "P\nr")
  1451.   (put-text-property beg
  1452.              end 
  1453.              'face (if eval-only 'Splus-eval 'Splus-eval-insert))
  1454.   (put-text-property beg
  1455.              end
  1456.              'mouse-face 'book-mouse-face)  
  1457.   (or eval-only
  1458.       (not book-maxima-auto-result-insert)
  1459.       (book-result-next end)
  1460.       (save-excursion (goto-char end)
  1461.               (insert
  1462.                (nth (random (length book-maxima-auto-result-insert))
  1463.                 book-maxima-auto-result-insert))
  1464.               (book-insert-sample-result)))
  1465.   (show-saved-properties beg)
  1466.   )
  1467. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1468. (defvar book-Splus-ready-for-input nil)
  1469. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1470. (defvar last-Splus-result nil)
  1471. (defun book-Splus-process-filter ( proc str)
  1472.   (let (tem )
  1473.     (book-process-filter proc str)
  1474.     (put-process-prop proc 'last-output
  1475.               (concat (get-process-prop proc 'last-output)
  1476.                   str))
  1477.     (cond ((setq tem (string-match ">[ ]*$"
  1478.                    (get-process-prop proc 'last-output)))
  1479.        (setq book-Splus-ready-for-input t)
  1480.        (setq last-Splus-result
  1481.          (substring (get-process-prop proc 'last-output)  0 tem ))
  1482.        (put-process-prop proc 'last-output "")
  1483.        )
  1484.       )))
  1485. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1486. (defun Splus-restart ()
  1487.   (setq Splus-eval nil)
  1488.   (if (get-buffer "*Splus-eval*")
  1489.       (kill-buffer (get-buffer "*Splus-eval*") )))
  1490.  
  1491. (defun book-Splus-interrupt ()
  1492.   "Interrupt the *Splus-eval* process running for book mode"
  1493.   (interactive)
  1494.   (cond (Splus-eval
  1495.      (interrupt-process Splus-eval))
  1496.     (t (error "*Splus-eval* process not found"))))
  1497.  
  1498. (defun Splus-eval (beg end type)
  1499.   "Evaluate the region returning a result"
  1500.   (let (tem (process (get-process  "*Splus-eval*")))
  1501.     (cond ((not  (and Splus-eval
  1502.               (setq process (get-buffer-process Splus-eval))))
  1503.        (cond ((and under-x-windows x-display-name
  1504.                (not (getenv "DISPLAY")))
  1505.           (setq process-environment
  1506.             (cons (concat "DISPLAY=" x-display-name)
  1507.                   process-environment))))
  1508.        (let ((default-directory "~/"))
  1509.          (setq Splus-eval (make-sshell "Splus-eval" "Splus" )))
  1510.        (setq process (get-buffer-process  Splus-eval))
  1511.        (set-process-filter process 'book-Splus-process-filter)
  1512.        (process-send-string process  "\n")
  1513.        )
  1514.       )
  1515.     (let ((com (buffer-substring beg end)))
  1516.       (setq com (concat com "\n"))
  1517.       (while (not book-Splus-ready-for-input)
  1518.     (message "waiting till Splus ready for input..")
  1519.     (process-send-string process "\n")
  1520.     (sleep-for 1))
  1521.       (message  "sending command :%s " com )
  1522.       
  1523.       (setq last-Splus-result nil)
  1524.       (process-send-string process com)
  1525.       )
  1526.     (cond ((equal type 'Splus-eval-insert)
  1527.        (while (not last-Splus-result)
  1528.          (message "waiting for result...")
  1529.          (sleep-for 1)
  1530.          )
  1531.        (message "done")
  1532.        (setq tem (Splus-trim-result  last-Splus-result))
  1533.        (setq last-Splus-result nil)
  1534.        tem))))
  1535.  
  1536. (defun Splus-trim-result (x)
  1537.   (let (tem)
  1538.     (cond ((equal 0 (count-expr "\n" x))
  1539.        (setq x "OK")
  1540.        x)
  1541.        ((equal 1 (count-expr "\n" x))
  1542.        (cond ((string-match "\[[0-9]+\]" x)
  1543.           (setq x (substring x (match-end 0)))))
  1544.        (cond ((setq tem (string-match "\n$" x))
  1545.           (setq x (substring x 0 tem))))
  1546.        (cond ((not (string-match "\n" x))
  1547.           (cond ((string-match "[ \t]+" x)
  1548.              (setq x (substring x (match-end 0)))))))
  1549.        x)
  1550.       (t x))))
  1551.  
  1552. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1553. ;;;;;;;;;;; code for Mathematica evaluation.;;;;;;;;;;;
  1554. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1555. ;;
  1556. ;; make mma-eval-insert face do insertion of result
  1557. ;;
  1558. (def-book-face  'mma-eval-insert 'mma-eval 'underline "yellow3" "black" )
  1559. (put 'mma-eval-insert 'insert t)
  1560. (def-book-face 'mma-eval 'mma-eval 'underline "yellow3" "black" )
  1561. (defvar mma-eval nil)
  1562.  
  1563. (defun book-mark-for-mma-eval (eval-only beg end)
  1564.   "Mark the current region to be evaluated by Mathematica and
  1565. substituted in the next book result region.   If a
  1566. numeric arg is supplied, dont wait for the evaluation nor
  1567. insert the result.  The variable book-maxima-auto-result-insert
  1568. affects whether a sample result is inserted.
  1569. "
  1570.   (interactive "P\nr")
  1571.   (put-text-property beg
  1572.              end 
  1573.              'face (if eval-only 'mma-eval 'mma-eval-insert))
  1574.   (put-text-property beg
  1575.              end
  1576.              'mouse-face 'book-mouse-face)  
  1577.   (or eval-only
  1578.       (not book-maxima-auto-result-insert)
  1579.       (book-result-next end)
  1580.       (save-excursion (goto-char end)
  1581.               (insert
  1582.                (nth (random (length book-maxima-auto-result-insert))
  1583.                 book-maxima-auto-result-insert))
  1584.               (book-insert-sample-result)))
  1585.   (show-saved-properties beg)
  1586.   )
  1587. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1588. (defvar book-mma-ready-for-input nil)
  1589. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1590. (defvar last-mma-result nil)
  1591. (defun book-mma-process-filter ( proc str)
  1592.   (let (tem )
  1593.     (book-process-filter proc str)
  1594.     (put-process-prop proc 'last-output
  1595.               (concat (get-process-prop proc 'last-output)
  1596.                   str))
  1597.     (cond ((setq tem (string-match "In\[[0-9]+\]:=[ ]*$"
  1598.                    (get-process-prop proc 'last-output)))
  1599.        (setq book-mma-ready-for-input t)
  1600.        (setq last-mma-result
  1601.          (substring (get-process-prop proc 'last-output)  0 tem ))
  1602.        (put-process-prop proc 'last-output "")
  1603.        )
  1604.       )))
  1605. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1606. (defun mma-restart ()
  1607.   (setq mma-eval nil)
  1608.   (if (get-buffer "*mma-eval*")
  1609.       (kill-buffer (get-buffer "*mma-eval*") )))
  1610.  
  1611. (defun book-mma-interrupt ()
  1612.   "Interrupt the *mma-eval* process running for book mode"
  1613.   (interactive)
  1614.   (cond (mma-eval
  1615.      (interrupt-process mma-eval))
  1616.     (t (error "*mma-eval* process not found"))))
  1617.  
  1618. (defun mma-eval (beg end type)
  1619.   "Evaluate the region returning a result"
  1620.   (let (tem (process (get-process  "*mma-eval*")))
  1621.     (cond ((not  (and mma-eval
  1622.               (setq process (get-buffer-process mma-eval))))
  1623.        (cond ((and under-x-windows x-display-name
  1624.                (not (getenv "DISPLAY")))
  1625.           (setq process-environment
  1626.             (cons (concat "DISPLAY=" x-display-name)
  1627.                   process-environment))))
  1628.        (let ((default-directory "~/"))
  1629.          (setq mma-eval (make-sshell "mma-eval" "math" )))
  1630.        (setq process (get-buffer-process  mma-eval))
  1631.        (set-process-filter process 'book-mma-process-filter)
  1632.        (process-send-string process  "\n")
  1633.        )
  1634.       )
  1635.     (let ((com (buffer-substring beg end)))
  1636.       (setq com (concat com "\n"))
  1637.       (while (not book-mma-ready-for-input)
  1638.     (message "waiting till Mathematica ready for input..")
  1639.     (process-send-string process "\n")
  1640.     (sleep-for 1))
  1641.       (message  "sending command :%s " com )
  1642.       
  1643.       (setq last-mma-result nil)
  1644.       (process-send-string process com)
  1645.       )
  1646.     (cond ((equal type 'mma-eval-insert)
  1647.        (while (not last-mma-result)
  1648.          (message "waiting for result...")
  1649.          (sleep-for 1)
  1650.          )
  1651.        (message "done")
  1652.        (setq tem (mma-trim-result  last-mma-result))
  1653.        (setq last-mma-result nil)
  1654.        tem))))
  1655. ;;;;
  1656. (defun mma-trim-result (str)
  1657.   (let ( (tem) (x) )
  1658.     (setq x str) 
  1659.     ;;
  1660.     ;; if there is output at all, x is at least of length 2
  1661.     ;; including a trailling \n\n.
  1662.     ;; Strip the beginning \n and one ending \n out.
  1663.     ;;
  1664.     (if (< (length x) 2) 
  1665.     (setq x "OK")
  1666.       (cond ((string-match "Out\[[0-9]+\]=" x)
  1667.          (setq x (substring x 1 (- (length x ) 1))))))
  1668.     ;;
  1669.     (cond ((equal 1 (count-expr "\n" x))
  1670.        (cond ((string-match "Out\[[0-9]+\]=[ ]+" x)
  1671.           (setq x (substring x (match-end 0)))))
  1672.        (cond ((setq tem (string-match "\n$" x))
  1673.           (setq x (substring x 0 tem))))
  1674.        x)
  1675.       (t (cond ((setq tem (string-match "Out\[[0-9]+\]=[ ]" x))
  1676.             (while (< tem (match-end 0))
  1677.               (aset x tem ? )
  1678.               (setq tem (+ tem 1)))))
  1679.          x))))
  1680. ;;;
  1681. (provide 'bookmode)
  1682.  
  1683. ;;; Local Variables: ***
  1684. ;;; version-control: t ***
  1685. ;;; End: ***
  1686.  
  1687.